home *** CD-ROM | disk | FTP | other *** search
/ HPAVC / HPAVC CD-ROM.iso / HFTUBE.ZIP / TUBEPIC.PAS < prev    next >
Pascal/Delphi Source File  |  1995-05-11  |  2KB  |  44 lines
  1. Program TubePic;
  2. {$M 4096,0,0}
  3. Uses Crt;
  4. Const OutputFile='TUBE.MAP';
  5.       BaseCol:Array[0..7] Of Byte=(62,63,126,127,190,191,254,255);
  6.       ColorDec=0.92;
  7. Var Palette,NewPal:Array[0..767] Of Byte;
  8.     Line:Array[0..511] Of Byte;
  9.     Fil1,Fil2:File;
  10.     Wid,N,X:Word;
  11.     R,G,B:Real;
  12.     Hei,Y,ColCnt:Byte;
  13. Begin
  14.  Asm Mov Ax,0003h; Int 10h; End;
  15.  If ParamCount=0 Then Begin
  16.   WriteLn('Usage: TubePic <picture file>'); Halt(0); End;
  17.  Assign(Fil1,ParamStr(1)); {$I-} Reset(Fil1,1);
  18.  If IOResult<>0 Then Begin WriteLn('File not found!'); Halt(1); End;
  19.  Assign(Fil2,OutputFile); ReWrite(Fil2,1);
  20.  BlockRead(Fil1,Palette,768); BlockRead(Fil1,Wid,2); BlockRead(Fil1,Hei,1);
  21.  
  22.  For ColCnt:=0 to 7 Do Begin
  23.   R:=Palette[ColCnt*3+0]; G:=Palette[ColCnt*3+1]; B:=Palette[ColCnt*3+2];
  24.   For N:=0 to 31 Do Begin
  25.    NewPal[BaseCol[ColCnt]*3+0-N*6]:=Round(R);
  26.    NewPal[BaseCol[ColCnt]*3+1-N*6]:=Round(G);
  27.    NewPal[BaseCol[ColCnt]*3+2-N*6]:=Round(B);
  28.    R:=R*ColorDec; G:=G*ColorDec; B:=B*ColorDec;
  29.   End;
  30.  End;
  31.  BlockWrite(Fil2,NewPal,768); BlockWrite(Fil2,Wid,2); BlockWrite(Fil2,Hei,1);
  32.  For Y:=0 to Hei-1 Do Begin
  33.   BlockRead(Fil1,Line,Wid);
  34.   For X:=0 to Wid-1 Do Line[X]:=BaseCol[Line[X]];
  35.   BlockWrite(Fil2,Line,Wid); End;
  36.  Close(Fil2); Close(Fil1);
  37.  
  38.  Asm Mov Ax,0013h; Int 10h; End;
  39.  Port[$3C8]:=0; For N:=0 to 767 Do Port[$3C9]:=NewPal[N];
  40.  For N:=0 to 255 Do For Y:=0 to 199 Do Mem[$A000:Y*320+N]:=N;
  41.  Repeat Until KeyPressed;
  42.  Asm Mov Ax,0003h; Int 10h; End;
  43. End.
  44.